home *** CD-ROM | disk | FTP | other *** search
/ MACD 5 / MACD 5.bin / workbench / boot / czesc_2 / smsrc / smprefs / list.pas < prev    next >
Pascal/Delphi Source File  |  1995-07-11  |  4KB  |  173 lines
  1. { create a new MyNode, initilising certain values }
  2. Function Add_Name;
  3. VAR
  4.     namenode : pMyNode;
  5.     strn     : STRPTR;
  6.  
  7. begin
  8.     namenode := AllocRemember(@RememberKey, sizeof(tMyNode), MEMF_CLEAR OR MEMF_PUBLIC);
  9.     namenode^.LSK_Name         := name;
  10.     namenode^.LSK_Node.ln_Name := NIL;
  11.     namenode^.LSK_Node.ln_Type := NT_USER;
  12.     namenode^.LSK_Node.ln_Succ := NIL;
  13.     namenode^.LSK_Node.ln_Pred := NIL;
  14.     namenode^.LSK_Node.ln_Pri  := 0;
  15.     namenode^.LSK_Cmd[1]       := ''#0;
  16.     namenode^.LSK_Cmd[1]       := 'None'#0;
  17.     namenode^.LSK_Key          := ''#0;
  18.     namenode^.LSK_RexxCmd      := 'id SM_CHOICE';
  19.     namenode^.LSK_RexxPort     := 'PLAY';
  20.     namenode^.LSK_Priority     := 0;
  21.     namenode^.LSK_Stack        := 4096;
  22.     namenode^.LSK_ASynch       := False;
  23.     namenode^.LSK_Output       := 'CON:0/11/640/150/Startup-Menu Command/AUTO/CLOSE/WAIT/ALT0/11/80/50';
  24.     namenode^.LSK_Quit         := True;
  25.     namenode^.LSK_NewShell     := False;
  26.     namenode^.LSK_ShellFrom    := '';
  27.     namenode^.LSK_ShellWin     := '';
  28.  
  29.     AddHead(CurrentList, pNode(namenode));
  30.     add_name := namenode;
  31. end;
  32.  
  33. { Detach the list from the Listview gadget }
  34. Procedure DetachObjectList;
  35.  
  36. VAR 
  37.     Tag_Array : array[0..1] of tTagItem;
  38.  
  39. begin
  40.     Tag_Array[0].ti_Tag  := GTLV_Labels;
  41.     Tag_Array[0].ti_Data := $FFFFFFFF;
  42.     Tag_Array[1].ti_Tag  := TAG_END;
  43.     GT_SetGadgetAttrsA(gads[G_LV], Thewindow, NIL, @Tag_Array);
  44. end;
  45.  
  46. { disable list manipulation gadgets }
  47. Procedure DisableObjectGadgets(Disable : byte);
  48.  
  49. begin
  50.     DisableGadget(gads[G_B_TOP],     TheWindow, Disable);
  51.     DisableGadget(gads[G_B_UP],      TheWindow, Disable);
  52.     DisableGadget(gads[G_B_DOWN],    TheWindow, Disable);
  53.     DisableGadget(gads[G_B_BOTTOM],  TheWindow, Disable);
  54.     DisableGadget(gads[G_B_REMOVE],  TheWindow, Disable);
  55.     DisableGadget(gads[G_B_COPY],    TheWindow, Disable);
  56. end;
  57.  
  58. { Attach the list to the Listview gadget }
  59. Procedure AttachObjectList;
  60.  
  61. VAR 
  62.     Tag_Array : array[0..4] of tTagItem;
  63.     
  64. CONST
  65.     GTLV_MakeVisible = $8008004E;
  66.  
  67. begin
  68.     Tag_Array[0].ti_Tag  := GTLV_Labels;
  69.     Tag_Array[0].ti_Data := LONG(CurrentList);
  70.     Tag_Array[1].ti_Tag  := GTLV_Top;      
  71.     Tag_Array[1].ti_Data := CurrentTop;
  72.     Tag_Array[2].ti_Tag  := GTLV_Selected; 
  73.     Tag_Array[2].ti_Data := CurrentOrd;
  74.     Tag_Array[3].ti_Tag  := GTLV_MakeVisible; 
  75.     Tag_Array[3].ti_Data := CurrentOrd;
  76.     Tag_Array[4].ti_Tag  := TAG_END;
  77.     GT_SetGadgetAttrsA(gads[G_LV], TheWindow, NIL, @Tag_Array);
  78. end;
  79.  
  80. { sort the list using a bubble sort }
  81. Procedure SortGadgetFunc;
  82.  
  83. VAR
  84.     notfinished : Boolean;
  85.     first, second, tmpnode : pNode;
  86.     n,i :integer;
  87.  
  88. begin
  89.     IF CurrentList^.lh_Head^.ln_Succ <> NIL then begin
  90.         wl := pointer(rtLockWindow(TheWindow));
  91.         notfinished := true;
  92.         (* Detach object list *)
  93.         DetachObjectList;
  94.         tmpnode := currentlist^.lh_Head;
  95.         i := 0;
  96.         while tmpnode <> NIL do begin
  97.             tmpnode := tmpnode^.ln_Succ;
  98.             i := i + 1;
  99.         end;
  100.         i := i-2;
  101.  
  102.         (* Sort list (quick & dirty bubble sort) *)
  103.         while (notfinished) do begin
  104.  
  105.             (* Reset not finished flag *)
  106.             notfinished := FALSE;
  107.  
  108.             (* Get first node *)
  109.             first := currentlist^.lh_Head;
  110.             if first <> NIL then begin
  111.                 n := 0;
  112.                 (* One bubble sort round *)
  113.                 second := first^.ln_Succ;
  114.                 while n <> i do begin
  115.  
  116.                     (* Compare *)
  117.                     n := n + 1;
  118.                     if (stricmp(first^.ln_Name,second^.ln_Name)>0) then begin
  119.                         (* Swap *)
  120.                         Remove(first);
  121.                         Insert_(CurrentList,first,second);
  122.                         notfinished := TRUE;
  123.                     end else
  124.                         (* Next *)
  125.                         first := second;
  126.                     second := first^.ln_Succ;
  127.                 end;
  128.             end;
  129.         end;
  130.         (* Reset pointers *)
  131.         CurrentNode := NIL;
  132.         CurrentOrd := -1;
  133.         CurrentTop := 0;
  134.  
  135.         (* Deactivate object gadgets *)
  136.         DisableObjectGadgets(TRUE_);
  137.  
  138.         (* Attach object list *)
  139.         AttachObjectList;
  140.         rtUnLockWindow(TheWindow, wl);
  141.     end;
  142. end;
  143.  
  144. { calculate the down value from a given across }
  145. Function CalcDown;
  146.  
  147. VAR
  148.     tmpnode : pNode;
  149.     o : integer;
  150.     down : integer;
  151.     tags : array[0..1] of tTagItem;
  152.  
  153. begin
  154.     DetachObjectList;
  155.     tmpnode := currentlist^.lh_Head;
  156.     o := -1;
  157.     while tmpnode <> NIL do begin
  158.         tmpnode := tmpnode^.ln_Succ;
  159.         o := o + 1;
  160.     end;
  161.     down := o div across;
  162.     while (down * across) < o do begin
  163.         down := down + 1;
  164.     end;
  165.     if (gad <> NIL) and (win <> NIL) then begin
  166.         tags[0].ti_Tag  := GTNM_Number;
  167.         tags[0].ti_Data := down;
  168.         tags[1].ti_Tag  := TAG_DONE;
  169.         GT_SetGadgetAttrsA(gad, Win, NIL, @tags);
  170.     End;
  171.     AttachObjectList;
  172.     calcdown := down; 
  173. end;